home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / intrfc55.arc / DUMP.PAS < prev    next >
Pascal/Delphi Source File  |  1990-02-25  |  2KB  |  120 lines
  1. unit dump;
  2. {  Various routines to dump memory to system.output  }
  3.  
  4. interface
  5.  
  6. procedure dumpbytes(var loc;start,num:word);
  7. procedure dumpwords(var loc;start,num:word);
  8. function hexbyte(b:byte):string;
  9. function hexword(w:word):string;
  10. function hexword2(w:word):string;
  11.  
  12. implementation
  13.  
  14. uses
  15.   util;
  16.  
  17. function hexbyte(b:byte):string;
  18. const
  19.   symbol : array[0..$f] of char = ('0','1','2','3','4','5','6','7',
  20.                                    '8','9','A','B','C','D','E','F');
  21. begin
  22.   hexbyte := symbol[b shr 4] + symbol[b and $f];
  23. end;
  24.  
  25. function hexword(w:word):string;
  26. begin
  27.   hexword := hexbyte(hi(w))+hexbyte(lo(w));
  28. end;
  29.  
  30. function hexword2(w:word):string;
  31. var
  32.   i : byte;
  33.   h : string;
  34. begin
  35.   h := hexword(w);
  36.   for i:=1 to length(h)-1 do
  37.   begin
  38.     if h[i] <> '0' then
  39.     begin
  40.       hexword2 := h;
  41.       exit;
  42.     end;
  43.     h[i] := ' ';
  44.   end;
  45.   hexword2 := h;
  46. end;
  47.  
  48. function legal(b:byte):char;
  49. begin
  50.   if b<32 then
  51.     legal := '.'
  52.   else
  53.     legal := char(b);
  54. end;
  55.  
  56. procedure dumpbytes(var loc;start,num:word);
  57. var
  58.   bytes:array[0..65520] of byte absolute loc;
  59.   i,j:word;
  60. procedure dumpascii(last:word);
  61. var
  62.   j : word;
  63. begin
  64.   for j:=0 to last do
  65.   begin
  66.     write(legal(bytes[i-$F+j]));
  67.   end;
  68. end;
  69. begin
  70.   for i:=0 to num-1 do
  71.   begin
  72.     case i mod 16 of
  73.     0: begin
  74.          writeln;
  75.          write(hexword(i+start),':');
  76.        end;
  77.     8: write(' ');
  78.     end;
  79.     write(hexbyte(bytes[i+start]):3);
  80.     if i mod 16 = $F then
  81.     begin
  82.       write('  ');
  83.       dumpascii($F);
  84.     end;
  85.   end;
  86.   if (num-1) mod 16 < $F then
  87.   begin
  88.     for j := num mod 16 to $f do
  89.     begin
  90.       write('   ');
  91.       if j = 8 then
  92.       write(' ');
  93.     end;
  94.     write('  ');
  95.     i := 16*((num-1) div 16) + $F;
  96.     dumpascii((num-1) mod 16);
  97.   end;
  98.   writeln;
  99. end;
  100.  
  101. procedure dumpwords(var loc;start,num:word);
  102. var
  103.   words:array[0..32760] of word absolute loc;
  104.   i:word;
  105. begin
  106.   repeat
  107.     write(hexword(start):4);
  108.     for i:=1 to minw(15,num) do
  109.       write(hexword(start+i):5);
  110.     writeln;
  111.     write(hexword(words[start]));
  112.     for i:=1 to minw(15,num) do
  113.       write(hexword(words[start+i]):5);
  114.     writeln;
  115.     inc(start,16);
  116.     dec(num,16);
  117.   until num > 65535 - 16;
  118. end;
  119.  
  120. end.